home *** CD-ROM | disk | FTP | other *** search
/ AmigActive 21 / AACD 21.iso / AACD / Programming / amigatalk / system / GamePort.st < prev    next >
Encoding:
Text File  |  2001-02-07  |  8.0 KB  |  316 lines
  1. " ---------------------------------------------------------------------"
  2. " GamePort Class is an abstract Class that allows the user of AmigaTalk"
  3. " to utilize the GamePort Device that the Amiga PC uses to detect      "
  4. " input events, such as mouse movement or button clicks or joystick    "
  5. " movement. "
  6. " ---------------------------------------------------------------------"
  7. "  WARNING:  You should know what you're doing to the Amiga OS before  "
  8. "            messing with this Class, or any other System Class!       "
  9. " ---------------------------------------------------------------------"
  10.  
  11. Class GamePort :Device
  12. [
  13.   openGamePort: whichUnit named: portname
  14.     ^ super subclassResponsibility: 'openGamePort:named:'
  15. |
  16.   getControllerType: portname
  17.     "The integer returned by this method is one of the following: "
  18.  
  19.      "  GPCT_ALLOCATED    -1"
  20.      "  GPCT_NOCONTROLLER  0"
  21.      "  GPCT_MOUSE         1" 
  22.      "  GPCT_RELJOYSTICK   2"
  23.      "  GPCT_ABSJOYSTICK   3"
  24.     ^ <primitive 223 7 portname>
  25. |
  26.   new: dummy
  27.     ^ super doesNotUnderstand: 'new:' 
  28. ]
  29.  
  30. " -------------------------------------------------------------------- "
  31. " Mouse Class allows the User to setup & use a Mouse.                  "
  32. " -------------------------------------------------------------------- "
  33.  
  34. Class Mouse :GamePort
  35. ! pname !
  36. [
  37.   openMousePort: whichUnit named: portname ! chk !
  38.     <primitive 223 1 portname whichUnit>.
  39.  
  40.     chk <- <primitive 223 7 portname>.
  41.  
  42.     (chk == 0)
  43.        ifTrue:  [ <primitive 223 8 portname 1>.  "GPCT_MOUSE <- 1"
  44.                   pname <- portname.
  45.                   ^ self
  46.                 ]
  47.        ifFalse: [ self error: 'Mouse port ',whichUnit,' already in use!'. 
  48.                   ^ pname <- nil
  49.                 ]
  50. |   
  51.   closeMousePort
  52.     <primitive 223 0 pname>
  53. |
  54.   clearMousePortBuffer
  55.     <primitive 223 6 pname>
  56. |
  57.   getButtonCode
  58.     ^ <primitive 223 10 pname>
  59. |
  60.   getQualifiers
  61.     ^ <primitive 223 11 pname>
  62. |
  63.   getXPos
  64.     ^ <primitive 223 12 pname>
  65. |
  66.   getYPos
  67.     ^ <primitive 223 13 pname>
  68. |
  69.   getIEAddress
  70.     ^ <primitive 223 14 pname>
  71. |
  72.   getTimeStamp
  73.     ^ <primitive 223 15 pname>
  74. |   
  75.   getTriggerKeys
  76.     ^ <primitive 223 16 pname>
  77. |
  78.   getTriggerTime
  79.     ^ <primitive 223 17 pname>
  80. |         
  81.   getTriggerXDelta
  82.     ^ <primitive 223 18 pname>
  83. |
  84.   getTriggerYDelta
  85.     ^ <primitive 223 19 pname>
  86. |
  87.   setKeyTransition: transType
  88.  
  89.     "GPTF_UPKEYS = 2, GPTF_DOWNKEYS = 1 or GPTF_DOWNKEYS + GPTF_UPKEYS:"
  90.  
  91.     (transType >= 1 & transType <= 3)
  92.       ifTrue:  [ <primitive 223 2 pname transType> ]
  93.       ifFalse: [ 'transType parameter out of range (1 to 3 only)!' print ]
  94. |
  95.   setTimeTransition: timeOutValue
  96.     (timeOutValue < 0)
  97.       ifTrue: [ 'timeOutValue out of range (S/B >= 0).' print.
  98.                 ^ nil 
  99.               ].
  100.     <primitive 223 3 pname timeOutValue>
  101. |
  102.   setXDeltaTransition: xvalue
  103.     <primitive 223 4 pname xvalue>
  104. |
  105.   setYDeltaTransition: yvalue
  106.     <primitive 223 5 pname yvalue>
  107. |
  108.   waitForButton:    kvalue ! ret !
  109.     ret <- self getButtonCode.
  110.     [ret = kvalue] whileFalse: [ret <- self getButtonCode]
  111. |
  112.   waitForQualifier: qvalue ! ret !
  113.     ret <- self getQualifiers.
  114.     [ret = qvalue] whileFalse: [ret <- self getQualifiers]
  115. |
  116.   waitForXPos: xvalue ! ret !
  117.     ret <- self getXPos.
  118.     [ret = xvalue] whileFalse: [ret <- self getXPos]
  119. |
  120.   waitForYPos: yvalue ! ret !
  121.     ret <- self getYPos.
  122.     [ret = yvalue] whileFalse: [ret <- self getYPos]
  123. ]
  124.  
  125. " -------------------------------------------------------------------- "
  126. " AbsJoyStick Class allows the User to setup & use an Absolute-type    "
  127. " JoyStick."
  128. " -------------------------------------------------------------------- "
  129.  
  130. Class AbsJoyStick :GamePort
  131. ! pname !
  132. [
  133.   openGamePort: whichUnit named: portname ! chk !
  134.     <primitive 223 1 portname whichUnit>.
  135.  
  136.     chk <- <primitive 223 7 portname>.
  137.  
  138.     (chk == 0)
  139.        ifTrue:  [ <primitive 223 8 portname 3>. "GPCT_ABSJOYSTICK <- 3"
  140.                   pname <- portname.
  141.                   ^ self
  142.                 ]
  143.        ifFalse: [ self error: 'Game port ',whichUnit,' already in use!'. 
  144.                   ^ pname <- nil
  145.                 ]
  146. |   
  147.   closeGamePort
  148.     <primitive 223 0 pname>
  149. |
  150.   clearGamePortBuffer
  151.     <primitive 223 6 pname>
  152. |
  153.   getButtonCode
  154.     ^ <primitive 223 10 pname>
  155. |
  156.   getQualifiers
  157.     ^ <primitive 223 11 pname>
  158. |
  159.   getXPos
  160.     ^ <primitive 223 12 pname>
  161. |
  162.   getYPos
  163.     ^ <primitive 223 13 pname>
  164. |
  165.   getIEAddress
  166.     ^ <primitive 223 14 pname>
  167. |
  168.   getTimeStamp
  169.     ^ <primitive 223 15 pname>
  170. |   
  171.   getTriggerKeys
  172.     ^ <primitive 223 16 pname>
  173. |
  174.   getTriggerTime
  175.     ^ <primitive 223 17 pname>
  176. |         
  177.   getTriggerXDelta
  178.     ^ <primitive 223 18 pname>
  179. |
  180.   getTriggerYDelta
  181.     ^ <primitive 223 19 pname>
  182. |
  183.   setKeyTransition: transType
  184.  
  185.     "GPTF_UPKEYS = 2, GPTF_DOWNKEYS = 1 or GPTF_DOWNKEYS + GPTF_UPKEYS:"
  186.  
  187.     (transType >= 1 & transType <= 3)
  188.       ifTrue:  [ <primitive 223 2 pname transType> ]
  189.       ifFalse: [ 'transType parameter out of range (1 to 3 only)!' print ]
  190. |
  191.   setTimeTransition: timeOutValue
  192.     (timeOutValue < 0)
  193.       ifTrue: [ 'timeOutValue out of range (S/B >= 0).' print.
  194.                 ^ nil 
  195.               ].
  196.     <primitive 223 3 pname timeOutValue>
  197. |
  198.   setXDeltaTransition: xvalue
  199.     <primitive 223 4 pname xvalue>
  200. |
  201.   setYDeltaTransition: yvalue
  202.     <primitive 223 5 pname yvalue>
  203. |
  204.   waitForButton:    kvalue ! ret !
  205.     ret <- self getButtonCode.
  206.     [ret = kvalue] whileFalse: [ret <- self getButtonCode]
  207. |
  208.   waitForQualifier: qvalue ! ret !
  209.     ret <- self getQualifiers.
  210.     [ret = qvalue] whileFalse: [ret <- self getQualifiers]
  211. |
  212.   waitForXPos: xvalue ! ret !
  213.     ret <- self getXPos.
  214.     [ret = xvalue] whileFalse: [ret <- self getXPos]
  215. |
  216.   waitForYPos: yvalue ! ret !
  217.     ret <- self getYPos.
  218.     [ret = yvalue] whileFalse: [ret <- self getYPos]
  219. ]
  220.  
  221. " -------------------------------------------------------------------- "
  222. " RelJoyStick Class allows the User to setup & use a Relative-type     "
  223. " (Analog) JoyStick."
  224. " -------------------------------------------------------------------- "
  225.  
  226. Class RelJoyStick :GamePort
  227. ! pname !
  228. [
  229.   openGamePort: whichUnit named: portname ! chk !
  230.     <primitive 223 1 portname whichUnit>.
  231.  
  232.     chk <- <primitive 223 7 portname>.
  233.  
  234.     (chk == 0)
  235.        ifTrue:  [ <primitive 223 8 portname 2>. "GPCT_RELJOYSTICK <- 2"
  236.                   pname <- portname.
  237.                   ^ self
  238.                 ]
  239.        ifFalse: [ self error: 'Game port ',whichUnit,' already in use!'. 
  240.                   ^ pname <- nil
  241.                 ]
  242. |   
  243.   closeGamePort
  244.     <primitive 223 0 pname>
  245. |
  246.   clearGamePortBuffer
  247.     <primitive 223 6 pname>
  248. |
  249.   getButtonCode
  250.     ^ <primitive 223 10 pname>
  251. |
  252.   getQualifiers
  253.     ^ <primitive 223 11 pname>
  254. |
  255.   getXPos
  256.     ^ <primitive 223 12 pname>
  257. |
  258.   getYPos
  259.     ^ <primitive 223 13 pname>
  260. |
  261.   getIEAddress
  262.     ^ <primitive 223 14 pname>
  263. |
  264.   getTimeStamp
  265.     ^ <primitive 223 15 pname>
  266. |   
  267.   getTriggerKeys
  268.     ^ <primitive 223 16 pname>
  269. |
  270.   getTriggerTime
  271.     ^ <primitive 223 17 pname>
  272. |         
  273.   getTriggerXDelta
  274.     ^ <primitive 223 18 pname>
  275. |
  276.   getTriggerYDelta
  277.     ^ <primitive 223 19 pname>
  278. |
  279.   setKeyTransition: transType
  280.  
  281.     "GPTF_UPKEYS = 2, GPTF_DOWNKEYS = 1 or GPTF_DOWNKEYS + GPTF_UPKEYS:"
  282.  
  283.     (transType >= 1 & transType <= 3)
  284.       ifTrue:  [ <primitive 223 2 pname transType> ]
  285.       ifFalse: [ 'transType parameter out of range (1 to 3 only)!' print ]
  286. |
  287.   setTimeTransition: timeOutValue
  288.     (timeOutValue < 0)
  289.       ifTrue: [ 'timeOutValue out of range (S/B >= 0).' print.
  290.                 ^ nil 
  291.               ].
  292.     <primitive 223 3 pname timeOutValue>
  293. |
  294.   setXDeltaTransition: xvalue
  295.     <primitive 223 4 pname xvalue>
  296. |
  297.   setYDeltaTransition: yvalue
  298.     <primitive 223 5 pname yvalue>
  299. |
  300.   waitForButton:    kvalue ! ret !
  301.     ret <- self getButtonCode.
  302.     [ret = kvalue] whileFalse: [ret <- self getButtonCode]
  303. |
  304.   waitForQualifier: qvalue ! ret !
  305.     ret <- self getQualifiers.
  306.     [ret = qvalue] whileFalse: [ret <- self getQualifiers]
  307. |
  308.   waitForXPos: xvalue ! ret !
  309.     ret <- self getXPos.
  310.     [ret = xvalue] whileFalse: [ret <- self getXPos]
  311. |
  312.   waitForYPos: yvalue ! ret !
  313.     ret <- self getYPos.
  314.     [ret = yvalue] whileFalse: [ret <- self getYPos]
  315. ]
  316.